Course Coordinates
- Taught at the University of Konstanz by Hansjörg Neth (h.neth@uni.kn, SPDS, office D507).
- Winter 2018/2019: Mondays, 13:30–15:00, C511.
- Links to current course syllabus | ZeUS | Ilias
Artwork
Overview over generated plots:
Tiles
Showing the versions with borders:
Tile plots (random)
Tile plots (sorted)
Tile plots (with borders and numeric labels)
Random versions:
Sorted versions:
Poles
Showing the versions without borders:
Pole plots (random)
Pole plots (sorted)
Pole plots (with borders and numeric labels)
Random versions:
Sorted versions:
Settings
Text labels
# Define text labels: ------
course_title <- paste0("Data science for psychologists")
course_title_abb <- paste0("ds4psy")
name_hn <- "Hansjörg Neth"
lbl_psi <- expression(psi)
course <- paste0(name_hn, ":", " ", course_title)
# courseLeet slang (l33t)
See https://simple.wikipedia.org/wiki/Leet for details.
## Using leet / l33t slang: ------
# l33t rul35:
n4me <- "h4n5j03Rg n3+h" # e:3, a:4, s:5, o:0, t:+, r:R
d5 <- "d4+4 5c13nc3" # i:1
fp <- "f0R p5ych0l0g15+5"
course_l33t <- paste0(n4me, ":", " ", d5, " ", fp)
course_l33t
#> [1] "h4n5j03Rg n3+h: d4+4 5c13nc3 f0R p5ych0l0g15+5"
## Automation: -----
# Write functions to:
# - switch text to lower/upper case, capitalize, etc.
# - leetify a string of text (with sets of rules)
# - mix content (letters, words, ...) with noise (punctuation, space, random characters)
l33t_rul35 <- c("a" = "4",
"e" = "3",
"i" = "1",
"o" = "0",
"s" = "5",
"t" = "+",
"r" = "R")
txt <- "This is a short test string containing some text to leetify."
str_replace_all(txt, l33t_rul35)
#> [1] "Th15 15 4 5h0R+ +35+ 5+R1ng c0n+41n1ng 50m3 +3x+ +0 l33+1fy."
str_replace_all(tolower(course), l33t_rul35)
#> [1] "h4n5jöRg n3+h: d4+4 5c13nc3 f0R p5ych0l0g15+5"Data
# Dimensions:
n_rand <- sample(1:15, size = 1, replace = TRUE) # random integer (1:15)
n_x <- n_rand # random number
# n_x <- 8 # a specific number
n_y <- n_x
N <- (n_x * n_y)
# Vectors:
v_sort <- 1:N # Tile: bottom = seeblau; top = black | Polar: outer = black, center = seeblau.
v_sort <- rev(1:N) # Tile: bottom = black; top = seeblau | Polar: outer = seeblau, center = black.
# Colors:
col_sort <- rep("white", N) # default
lim_black <- .245 # threshold to switch from "white" to "black" labels
col_sort[(v_sort > (lim_black * N)) & (v_sort < ((1 - lim_black) * N))] <- "black"
# table(col_sort)
set.seed(123) # for reproducible randomness
# v_rand <- runif(n = N, 0, 1)
rand_ord <- sample(v_sort, N) # random permutation of v_sort
v_rand <- rand_ord # random permutation of v_sort
col_rand <- col_sort[rand_ord]
# Table:
tb <- tibble(y = rep(1:n_x, each = n_y),
x = rep(1:n_y, times = n_x),
sort = v_sort,
rand = v_rand,
col_sort = col_sort,
col_rand = col_rand
)
tb
#> # A tibble: 121 x 6
#> y x sort rand col_sort col_rand
#> <int> <int> <int> <int> <chr> <chr>
#> 1 1 1 121 87 white black
#> 2 1 2 120 27 white white
#> 3 1 3 119 73 white black
#> 4 1 4 118 17 white white
#> 5 1 5 117 11 white white
#> 6 1 6 116 116 white white
#> 7 1 7 115 61 white black
#> 8 1 8 114 20 white white
#> 9 1 9 113 59 white black
#> 10 1 10 112 70 white black
#> # … with 111 more rowsColors
# Re-sort color palette:
unikn.pal # from "ds4psy/R/custom_functions.R""
#> seeblau1 seeblau2 seeblau3 seeblau4 black seegrau4 seegrau3 seegrau2
#> 1 #CCEEF9 #A6E1F4 #59C7EB #00A9E0 #000000 #666666 #999999 #CCCCCC
#> seegrau1 white
#> 1 #E5E5E5 #FFFFFF
# (1) Sorted version:
unikn_sort <- unikn.pal[c(4, 4:1, 10:5)] # 11 colors (seeblau twice)
# unikn_sort
# (2) Sorted version with special cases (for small n_x):
if (n_x == 1) {
unikn_sort <- seeblau # 1 color (seeblau)
} else if (n_x == 2) {
unikn_sort <- unikn.pal[c(4, 2, 5, 9)] # 4 colors (black, but no white)
} else {
unikn_sort <- unikn.pal[c(4, 4:1, 10:5)] # 11 colors (seeblau twice)
}
unikn_sort # 11 colors: seeblau > white > black
#> seeblau4 seeblau4.1 seeblau3 seeblau2 seeblau1 white seegrau1 seegrau2
#> 1 #00A9E0 #00A9E0 #59C7EB #A6E1F4 #CCEEF9 #FFFFFF #E5E5E5 #CCCCCC
#> seegrau3 seegrau4 black
#> 1 #999999 #666666 #000000Plot themes
ds_theme <- theme_bw() +
theme(panel.grid = element_blank(),
legend.position = "none",
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.background = element_rect(fill = "white"),
panel.border = element_rect(color = grey(.25, 1)))
ds_theme <- theme_nothing()Tiles
Tile plots
- With thin borders:
# Parameters:
brd_col <- grey(0, 1)
brd_size <- .10
plot_size <- 3.0 # NORMAL: in cm (used in ggsave below): normal (small) size
# plot_size <- 10.0 # BIG: in cm (used in ggsave below): when "pix/big_"
lbl_size <- 1.5
pic_path <- "pix/"
# Tile plots: ------
# (1a) random version (WITH border lines):
tile_rand <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand), col = brd_col, size = brd_size) +
# geom_text(aes(x = x, y = y, label = rand), col = col_rand, size = lbl_size) + # with tile labels
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_rand
# Save current plot:
cur_name <- paste0("tile_rand_", n_x, "_brd.png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name) # insert sub-dir "tile"
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # sub-dir "big" and insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
# (1b) sorted version (WITH border lines):
tile_sort <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort), col = brd_col, size = brd_size) +
# geom_text(aes(x = x, y = y, label = sort), col = col_sort, size = lbl_size) + # with tile labels
# coord_polar() +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "4", y = expression(psi)) +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_sort
# Save current plot:
cur_name <- paste0("tile_sort_", n_x, "_brd.png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name)
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)- Without thin borders:
# Tile plots: ------
# (2a) random version (withOUT border lines):
tile_rand <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand))+ #, col = brd_col, size = brd_size) +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_rand
# Save current plot:
cur_name <- paste0("tile_rand_", n_x, ".png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name)
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
# (2b) sorted version (withOUT border lines):
tile_sort <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort))+ #, col = brd_col, size = brd_size) +
# coord_polar() +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "4", y = expression(psi)) +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_sort
# Save current plot:
cur_name <- paste0("tile_sort_", n_x, ".png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name)
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)- With thin borders and a numeric label (top left):
# Parameters:
cur_lbl <- paste0(n_x)
x_lbl <- 1
y_lbl <- (n_y + 1) + n_y/15
# Tile plots: ------
# (3a) random version (WITH border lines AND label):
tile_rand_lbl <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand), col = brd_col, size = brd_size) +
geom_text(x = x_lbl, y = y_lbl, label = cur_lbl, size = 2) +
scale_y_continuous(limits = c(0, y_lbl)) +
# geom_text(x = 0, y = n_y, label = cur_lbl, size = 2) +
# scale_x_continuous(limits = c(0, n_x + 1)) +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_rand_lbl
# Save current plot:
cur_name <- paste0("tile_rand_", n_x, "_brd_lbl.png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name)
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
# (3b) sorted version (WITH border lines AND label):
tile_sort_lbl <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort), col = brd_col, size = brd_size) +
geom_text(x = x_lbl, y = y_lbl, label = cur_lbl, size = 2) +
scale_y_continuous(limits = c(0, y_lbl)) +
# geom_text(x = 0, y = n_y, label = cur_lbl, size = 2) +
# scale_x_continuous(limits = c(0, n_x + 1)) +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
tile_sort_lbl
# Save current plot:
cur_name <- paste0("tile_sort_", n_x, "_brd_lbl.png")
if (plot_size < 10) {
plot_name <- paste0(pic_path, "tile/", cur_name)
} else {
plot_name <- paste0(pic_path, "big/", "big_", cur_name) # insert "big_" prefix
}
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)Polar plots
- With thin borders:
# Polar plots: ------
pole_rand <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand), col = brd_col, size = brd_size) +
# labs(title = "ds4psy") +
coord_polar() +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_rand
# Save current plot:
plot_name <- paste0("pix/pole/pole_rand_", n_x, "_brd.png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
pole_sort <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort), col = brd_col, size = brd_size) +
labs(x = "4", y = expression(psi)) +
coord_polar() +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_sort
# Save current plot:
plot_name <- paste0("pix/pole/pole_sort_", n_x, "_brd.png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)- Without thin borders:
# Polar plots: ------
pole_rand <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand)) + # , col = brd_col, size = brd_size) +
# labs(title = "ds4psy") +
coord_polar() +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_rand
# Save current plot:
plot_name <- paste0("pix/pole/pole_rand_", n_x, ".png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
pole_sort <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort)) + # , col = brd_col, size = brd_size) +
labs(x = "4", y = expression(psi)) +
coord_polar() +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_sort
# Save current plot:
plot_name <- paste0("pix/pole/pole_sort_", n_x, ".png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)- With thin borders and a numeric label (of the final slice):
# Parameters:
cur_lbl <- paste0(n_x)
if (n_y == 1) {
y_lbl <- n_y + 0 # no correction
} else if (n_y == 2) {
y_lbl <- n_y + .75 # small correction
} else if (n_y < 4) {
y_lbl <- n_y + 1 # constant correction
} else {
y_lbl <- n_y + n_y/4 # scaled correction (increasing with n_y)
}
# (a) rand version with label:
pole_rand_lbl <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = rand), col = brd_col, size = brd_size) +
# labs(title = "ds4psy") +
# scale_x_continuous(breaks = c(0:n_x), labels = c(0:n_x)) +
# geom_vline(xintercept = n_x, size = 1, color = "gold") +
geom_text(x = n_x, y = y_lbl, label = cur_lbl, size = 2) +
coord_polar() +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_rand_lbl
# Save current plot:
plot_name <- paste0("pix/pole/pole_rand_", n_x, "_brd_lbl.png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)
# (a) sort version with label:
pole_sort_lbl <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = sort), col = brd_col, size = brd_size) +
# labs(title = "ds4psy") +
# scale_x_continuous(breaks = c(0:n_x), labels = c(0:n_x)) +
# geom_vline(xintercept = n_x, size = 1, color = "gold") +
geom_text(x = n_x, y = y_lbl, label = cur_lbl, size = 2) +
coord_polar() +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_sort) +
ds_theme
pole_sort_lbl
# Save current plot:
plot_name <- paste0("pix/pole/pole_sort_", n_x, "_brd_lbl.png")
ggsave(plot_name, width = plot_size, height = plot_size, units = c("cm"), dpi = 300)Pi tiles
Add the 1st N digits of pi as data to tb:
#> # A tibble: 121 x 6
#> y x sort rand col_sort col_rand
#> <int> <int> <int> <int> <chr> <chr>
#> 1 1 1 121 87 white black
#> 2 1 2 120 27 white white
#> 3 1 3 119 73 white black
#> 4 1 4 118 17 white white
#> 5 1 5 117 11 white white
#> 6 1 6 116 116 white white
#> 7 1 7 115 61 white black
#> 8 1 8 114 20 white white
#> 9 1 9 113 59 white black
#> 10 1 10 112 70 white black
#> # … with 111 more rows
#> [1] 121
#> [1] TRUE
#> [1] 3 1 4 1 5 9
#> # A tibble: 121 x 6
#> sort rand x y col_sort col_rand
#> <int> <int> <int> <int> <chr> <chr>
#> 1 1 16 11 11 white white
#> 2 2 97 10 11 white white
#> 3 3 100 9 11 white white
#> 4 4 94 8 11 white white
#> 5 5 50 7 11 white black
#> 6 6 86 6 11 white black
#> 7 7 101 5 11 white white
#> 8 8 114 4 11 white white
#> 9 9 74 3 11 white black
#> 10 10 85 2 11 white black
#> # … with 111 more rows
#> # A tibble: 121 x 9
#> sort rand x y col_sort col_rand pi_sort pi_rand col_pi
#> <int> <int> <int> <int> <chr> <chr> <dbl> <dbl> <chr>
#> 1 1 16 11 11 white white 3 3 black
#> 2 2 97 10 11 white white 1 7 white
#> 3 3 100 9 11 white white 4 7 black
#> 4 4 94 8 11 white white 1 2 white
#> 5 5 50 7 11 white black 5 1 black
#> 6 6 86 6 11 white black 9 0 black
#> 7 7 101 5 11 white white 2 9 white
#> 8 8 114 4 11 white white 6 8 black
#> 9 9 74 3 11 white black 5 2 black
#> 10 10 85 2 11 white black 3 8 black
#> # … with 111 more rows
Colors:
#> seeblau4 seeblau4.1 seeblau3 seeblau2 seeblau1 white seegrau1 seegrau2
#> 1 #00A9E0 #00A9E0 #59C7EB #A6E1F4 #CCEEF9 #FFFFFF #E5E5E5 #CCCCCC
#> seegrau3 seegrau4 black
#> 1 #999999 #666666 #000000
#> white black seegrau4 seeblau4 seeblau3 seeblau2 seeblau1 seegrau3
#> 1 #FFFFFF #000000 #666666 #00A9E0 #59C7EB #A6E1F4 #CCEEF9 #999999
#> seegrau2 seegrau1
#> 1 #CCCCCC #E5E5E5
Graphical version:
The first 121 digits of pi mapped to uni.kn color scale:
- 0 is white
- 1 is black
- 2 is dark grey
- 3 is seeblau
# Parameters:
cur_lbl <- expression(pi)
lbl_size <- 2
x_lbl <- 1
y_lbl <- (n_y + 1) + n_y/15
# Tile plots: ------
# tb # data
# (4a) sorted version (WITH border lines AND label):
pi_tile_sort_lbl <- ggplot(tb) +
geom_tile(aes(x = x, y = y, fill = pi_sort), col = brd_col, size = brd_size) +
geom_text(aes(x = x, y = y, label = pi_sort), col = "black", size = lbl_size) + # pi values as tile labels
scale_y_continuous(limits = c(0, y_lbl)) +
# scale_x_continuous(limits = c(0, n_x + 1)) +
coord_fixed() +
# labs(title = "ds4psy") +
labs(x = "Data", y = "Science") +
# scale_fill_continuous(low = "white", high = seeblau) +
scale_fill_gradientn(colors = unikn_pi) +
ds_theme
pi_tile_sort_lblCombine multiple plots
plot_grid(tile_rand, tile_sort)
plot_grid(pole_rand, pole_sort)
plot_grid(tile_rand, pole_sort)Waves
Data:
N <- 100000
df <- tibble(x = 1:N,
a = rnorm(n = N, mean = 0, sd = 250),
# b = rnorm(n = N, mean = 100, sd = 200),
c = rnorm(n = N, mean = 500, sd = 200)
)
# dfDensity plots:
lwd_all <- 3
ggplot(df) +
geom_density(aes(x = a), col = seeblau, fill = "black", lwd = lwd_all, alpha = .25) +
# geom_density(aes(x = b), col = "black", fill = unikn.pal[[5]], alpha = .33) +
geom_density(aes(x = c), col = "black", fill = seeblau, lwd = lwd_all, alpha = .33) +
theme_void()Histograms (with function curves):
lwd_all <- .75
# overlay histogram and normal density
ggplot(df) +
geom_histogram(aes(x = c, y = stat(density)), binwidth = 150, col = "white", fill = "black", alpha = .25) +
geom_histogram(aes(x = a, y = stat(density)), binwidth = 150, col = "white", fill = seeblau, alpha = .25) +
stat_function(fun = dnorm, args = list(mean = mean(df$c), sd = sd(df$c)), lwd = lwd_all, col = "black", alpha = .95) +
stat_function(fun = dnorm, args = list(mean = mean(df$a), sd = sd(df$a)), lwd = lwd_all, col = seeblau, alpha = .95) +
scale_x_continuous(limits = c(-2000, 1400)) +
theme_void() # + # annotate(geom = "text", x = -1900, y = .0018, label = course_title, color = "black", alpha = .90, adj = 0, fontface = 2, size = 2.5)
ggsave("pix/wave/hist_wave_2.png", width = 16, height = 8, units = c("cm"), dpi = 300)Waves (as curves):
# as curves:
lwd_all <- .75
ggplot(df) +
stat_function(fun = dnorm, args = list(mean = 300, sd = 275), lwd = lwd_all, col = "black", alpha = .99) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 300), lwd = lwd_all, col = seeblau, alpha = .40) +
stat_function(fun = dnorm, args = list(mean = 600, sd = 250), lwd = lwd_all, col = "black", alpha = .40) +
stat_function(fun = dnorm, args = list(mean = 900, sd = 225), lwd = lwd_all, col = seeblau, alpha = .75) +
scale_x_continuous(limits = c(-4000, 1700)) +
theme_void() # + # annotate(geom = "text", x = -3900, y = .0016, label = course_title, color = "black", alpha = .90, adj = 0, fontface = 2, size = 2.5)
ggsave("pix/wave/waves_4.png", width = 15, height = 1.5, units = c("cm"), dpi = 300)ToC art
ToC bar chart
ToC (chronology and relevance of sessions) as bar charts:
# N <- 10 # number of chapters/topics
# nr <- 1:N
# tp <- c("Introduction", "Chapter 2", "Chapter 3", "Chapter 4", "Chapter 5",
# "Chapter 6", "Chapter 7", "Chapter 8", "Chapter 9", "Chapter 10")
# val <- 10 + nr
# Table:
toc <- tribble(
~nr, ~tp, ~ctr,
0, "Introduction", 3,
1, "Basic R", 10, # was: "Basic R concepts and commands",
2, "Visualizing data", 8,
3, "Transforming data", 9,
4, "Exploring data", 10, # was: "Exploring data (EDA)"
5, "Tibbles", 7,
6, "Importing data", 5,
7, "Tidying data", 9,
8, "Joining data", 8,
9, "Functions", 9,
10, "Iteration", 7
)
toc <- toc %>% mutate(nr_val = nr + 10) # add constant to increase overall height of bars
# Parameters:
N <- nrow(toc)
max_nr_val <- max(toc$nr_val)
min_ctr <- min(toc$ctr)
max_ctr <- max(toc$ctr)
tol <- 4 # tolerance value (for text labels)
txt_size <- 2.5 # size of txt labels (below)
## Colors: ------
# unikn.pal # basic
unikn_toc <- c(rev(unikn.pal[5:10]), # white:black (6)
unikn.pal[1:4], # seeblau1 to 4 (4)
seeblau) # seeblau4 (1)
# unikn_toc # 11 colorsBar plots:
## Bar plots: ------
# (a) Chronology:
bar_hori <- ggplot(toc, aes(x = nr)) +
geom_bar(aes(y = ctr, fill = nr_val), stat = "identity", color = grey(.5, 1)) +
scale_fill_gradientn(colors = unikn_toc) +
geom_text(aes(y = ctr + .25, label = tp), angle = 0, adj = 0, size = txt_size) +
scale_x_reverse(breaks = 0:N, labels = 0:N) +
# scale_x_continuous(breaks = 0:N, labels = 0:N) +
scale_y_continuous(limits = c(0, (max_ctr + tol)), breaks = 1:max_ctr, labels = 1:max_ctr) +
theme_minimal() +
theme(legend.position = "none", panel.grid.minor = element_blank(), panel.grid.major.x = element_blank()) +
coord_flip() +
labs(title = "ds4psy: Chronology of sessions", x = "Session", y = "Relevance")
bar_hori
# Save plot:
cur_name <- paste0(pic_path, "toc/", "toc_chronology", ".png")
ggsave(cur_name, width = 15, height = 10, units = c("cm"), dpi = 300)
# (b) Relevance:
bar_vert <- ggplot(toc, aes(x = nr)) +
geom_bar(aes(y = ctr, fill = ctr), stat = "identity", color = grey(.5, 1)) +
# scale_fill_gradientn(colors = unikn_toc) +
scale_fill_gradient(low = "white", high = seeblau, limits = c(min_ctr, max_ctr)) +
geom_text(aes(y = ctr + .5, label = tp), angle = 90, adj = 0, size = txt_size) +
scale_x_continuous(breaks = 0:N, labels = 0:N) +
scale_y_continuous(limits = c(0, (max_ctr + tol)), breaks = 1:max_ctr, labels = 1:max_ctr) +
theme_minimal() +
theme(legend.position = "none", panel.grid.minor = element_blank()) +
labs(title = "ds4psy: Relevance of topics", x = "Session", y = "Relevance")
bar_vert
# Save plot:
cur_name <- paste0(pic_path, "toc/", "toc_relevance", ".png")
ggsave(cur_name, width = 15, height = 12, units = c("cm"), dpi = 300)ToC polar charts
ToC and current session as a clock chart (bar chart with polar coordinates):
# (2) Plots on polar coordinates:
tol <- 4 # tolerance value (for text labels)
## (A) Chronology (as clock):
topic_clock <- ggplot(toc, aes(x = nr)) +
geom_bar(aes(y = ctr, fill = nr_val), stat = "identity", color = grey(0, 1), size = .25) +
scale_fill_gradientn(colors = unikn_toc) +
# scale_fill_gradient(low = "white", high = seeblau, limits = c(min_ctr, max_ctr)) +
geom_text(aes(y = max_ctr + tol/2, label = tp), adj = .5, size = txt_size) +
scale_x_continuous(breaks = 0:N, labels = 0:N) +
scale_y_continuous(limits = c(0, (max_ctr + tol)), breaks = 1:max_ctr, labels = 1:max_ctr) +
coord_polar() +
# labs(title = "Centrality of topic", x = "Chapter", y = "Topic") +
# theme_void() +
theme_light() +
theme(legend.position = "none", axis.line = element_blank(),
axis.title = element_blank(), axis.text.y = element_blank(),
axis.ticks = element_blank(), panel.border = element_blank())
# topic_clock
## (B) Centrality of topic (as clock):
centrality <- ggplot(toc, aes(x = nr)) +
geom_bar(aes(y = ctr, fill = ctr), stat = "identity", color = grey(.10, 1), size = .25) +
# scale_fill_gradientn(colors = unikn_toc) +
scale_fill_gradient(low = "white", high = seeblau, limits = c(min_ctr, max_ctr)) +
geom_text(aes(y = (max_ctr + .65 * tol), label = tp), adj = .5, size = txt_size) +
scale_x_continuous(breaks = 0:N, labels = 0:N) +
scale_y_continuous(limits = c(0, (max_ctr + tol)), breaks = 1:max_ctr, labels = 1:max_ctr) +
coord_polar() +
# theme_void() +
theme_light() +
theme(#legend.position = "none",
axis.line = element_blank(),
axis.title = element_blank(), axis.text.y = element_blank(),
axis.ticks = element_blank(), panel.border = element_blank()) +
labs(fill = "Relevance:")
centrality
# Save plot:
cur_name <- paste0(pic_path, "toc/", "centrality", ".png")
ggsave(cur_name, width = 15, height = 15, units = c("cm"), dpi = 300)Related ideas:
- Add an outer ring with global structure:
- Basics (0–1)
- EDA (2–4)
- Data tables (5–8)
- Programming (9–10)
- Re-sort topics (e.g., move sessions on tibbles and importing data forward)
Current session clock
Highlight current session in polar chart:
# (C) Highlight the current session (in gold):
# session number:
n_rand <- sample(0:11, size = 1, replace = TRUE) # random integer (0:11)
nr_session <- n_rand # random session nr (as in polar clock plot above)
# nr_session <- 0 # specific session nr
tol <- 8 # increase tolerance value (to leave more space for text labels)
txt_size <- 2.0 # decrease (to keep topic labels within highlighted areas)
# Add current session_val to toc:
toc$session_val <- 0 # initialize session_val
toc$session_val[(nr_session + 1)] <- (max_ctr + tol) # maximum y-value
toc
#> # A tibble: 11 x 5
#> nr tp ctr nr_val session_val
#> <dbl> <chr> <dbl> <dbl> <dbl>
#> 1 0 Introduction 3 10 0
#> 2 1 Basic R 10 11 0
#> 3 2 Visualizing data 8 12 0
#> 4 3 Transforming data 9 13 0
#> 5 4 Exploring data 10 14 0
#> 6 5 Tibbles 7 15 0
#> 7 6 Importing data 5 16 0
#> 8 7 Tidying data 9 17 0
#> 9 8 Joining data 8 18 18
#> 10 9 Functions 9 19 0
#> 11 10 Iteration 7 20 0
cur_session_clock <- ggplot(toc, aes(x = nr)) +
geom_bar(aes(y = session_val), stat = "identity", fill = "gold", alpha = .75) +
geom_bar(aes(y = ctr, fill = ctr), stat = "identity", color = grey(.10, 1), size = .25) +
# scale_fill_gradientn(colors = unikn_toc) +
scale_fill_gradient(low = "white", high = seeblau, limits = c(min_ctr, max_ctr)) +
geom_text(aes(y = (max_ctr + .45 * tol), label = tp), adj = .5, size = txt_size, fontface = 1) + # topic labels
scale_x_continuous(breaks = 0:N, labels = 0:N) +
scale_y_continuous(limits = c(0, (max_ctr + tol)), breaks = 1:max_ctr, labels = 1:max_ctr) +
coord_polar() +
# theme_void() +
theme_light() +
theme(legend.position = "none",
axis.line = element_blank(),
axis.title = element_blank(), axis.text.y = element_blank(),
axis.ticks = element_blank(), panel.border = element_blank()) +
labs(fill = "Centrality:")
cur_session_clock
# Save plot:
cur_name <- paste0(pic_path, "toc/", "m_clock_", nr_session, ".png")
ggsave(cur_name, width = 10, height = 10, units = c("cm"), dpi = 300)Miscellaneous R art
See https://www.r-graph-gallery.com/portfolio/data-art/ for examples.
Matrix
# plotting parameters:
opar <- par(no.readonly = TRUE) # all par settings that can be changed.Original version:
# Source: http://www.r-graph-gallery.com/56-matrix-abstract-painting/
# generate pairs of x-y values
nx = 100
ny = 80
x = sample(x = 1:nx, size = 90, replace = TRUE)
y = seq(-1, -ny, length = 90)
# set graphical parameters:
op = par(bg = "black", mar = c(0, 0.2, 0, 0.2))
# plot:
plot(1:nx, seq(-1, -nx), type = "n", xlim = c(1, nx), ylim = c(-ny+10, 1))
for (i in seq_along(x))
{
aux = sample(1:ny, 1)
points(rep(x[i], aux), y[1:aux], pch = sample(letters, aux, replace = TRUE),
col = hsv(0.35, 1, 1, runif(aux, 0.3)), cex = runif(aux, 0.3))
}
# signature:
legend("bottomright", legend = "© Gaston Sanchez", bty = "n", text.col = "gray70")Adpated version:
# Source: http://www.r-graph-gallery.com/56-matrix-abstract-painting/
# generate pairs of x-y values
nx <- 100
ny <- 80
x <- sample(x = 1:nx, size = (nx - 10), replace = TRUE)
y <- seq(-1, -ny, length = (nx - 10))
# plotting parameters:
op <- par(bg = "black", mar = c(0, 0.2, 0, 0.2))
seeblau_rgb <- col2rgb(seeblau)
seeblau_hsv <- rgb2hsv(seeblau_rgb)
unikn_sample <- c("d", "s", "4", "p", "s", "y",
"3", "7", "9")
# Create empty plot:
plot(1:nx, seq(-1, -nx), type = "n", xlim = c(1, nx), ylim = c(-ny + 10, 1))
# Loop:
for (i in seq_along(x))
{
aux = sample(1:ny, 1)
points(rep(x[i], aux), y[1:aux], pch = sample(unikn_sample, aux, replace = TRUE),
col = hsv(seeblau_hsv[[1]], 1, 1, alpha = runif(aux, 0.3)), cex = runif(aux, 0.3))
}
## Save plot manually (as not a ggplot object)!
## Clean up:
par(opar) # restore original plot settingsRings
Original version:
# Source: http://www.r-graph-gallery.com/58-saturn-rings-abstract-painting/
# generate pairs of x-y values
x = seq(-50, 50, by = 1)
y = -(x^2)
# set graphic parameters
op = par(bg = 'black', mar = rep(0.5, 4))
# Plot
plot(y, x, type = 'n')
lines(y, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9)))
for (i in seq(10, 2500, 10))
{
lines(y-i, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(500, 600, 10))
{
lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(2000, 2300, 10))
{
lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(100, 150, 10))
{
lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
# signature
legend("bottomright", legend="© Gaston Sanchez", bty = "n", text.col="gray70")Adapted version:
# Adapted from: http://www.r-graph-gallery.com/58-saturn-rings-abstract-painting/
# generate pairs of x-y values:
x = seq(-50, 50, by = 1)
y = -(x^2)
# set graphic parameters:
op = par(bg = "black", mar = rep(.5, 4))
# op = par(bg = "white", mar = rep(.5, 4))
original_h <- .08 # original hue value
# Seeblau versions:
seeblau_rgb <- col2rgb(seeblau)
seeblau_hsv <- rgb2hsv(seeblau_rgb)
seeblau_hsv
# seeblau
# h 0.5409226
# s 1.0000000
# v 0.8784314
seeblau_h <- seeblau_hsv[[1]]
white_rgb <- col2rgb("white")
white_hsv <- rgb2hsv(white_rgb)
white_hsv # 0 0 1
grey_rgb <- col2rgb("grey")
grey_hsv <- rgb2hsv(grey_rgb)
grey_hsv # 0 0 0.75
# Plot:
plot(y, x, type = 'n')
# one:
lines(y, x, lwd = 2 * runif(1), col = hsv(seeblau_h, 1, 1, alpha = runif(1, .5, .9)))
# all:
for (i in seq(10, 2500, 10)) {
lines(y-i, x, lwd = 2 * runif(1), col = hsv(seeblau_h, 1, 1, alpha = runif(1, .5, .9)))
}
# inner:
for (i in seq(500, 600, 10)) {
lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}
# middle:
for (i in seq(2000, 2300, 10)) {
lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}
# outer:
for (i in seq(100, 150, 10)){
lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}
## Save plot manually (as not a ggplot object)!
## Clean up:
par(opar) # restore original plot settingsGrasslands
Original version:
# Source: https://www.r-graph-gallery.com/138-green-world-data-art/
library(ggplot2)
library(RColorBrewer)
set.seed(92)
ngroup=20
names=paste("G_",seq(1,ngroup),sep="")
DAT=data.frame()
for(i in seq(1:50)){
data=data.frame( matrix(0, ngroup , 3))
data[,1]=i
data[,2]=sample(names, nrow(data))
data[,3]=prop.table(sample( c(rep(0, 100), c(1:ngroup)), nrow(data)))
DAT=rbind(DAT,data)
}
colnames(DAT) = c("Year","Group","Value")
DAT = DAT[order(DAT$Year, DAT$Group), ]
ggplot(DAT, aes(x=Year, y=Value, fill=Group )) +
geom_area(alpha=1 , color="transparent" )+
theme_bw() +
scale_fill_brewer(palette="Greens", breaks=rev(levels(DAT$Group)))+
theme(line = element_blank(),
text = element_blank(),
title = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.background = element_blank())Adapted version:
# Adapted from: https://www.r-graph-gallery.com/138-green-world-data-art/
library(ggplot2)
library(RColorBrewer)
set.seed(101)
ngroup <- 20
names <- paste("G_", seq(1, ngroup), sep = "")
DAT <- data.frame()
# Color palette:
seeblau_pal <- sample(unikn.pal, size = ngroup, replace = TRUE)
seeblau_pal <- rep(c(unikn.pal[1], unikn.pal[2], unikn.pal[3], unikn.pal[4], unikn.pal[5]), 4)
for(i in seq(1:50)){
data = data.frame( matrix(0, ngroup , 3))
data[ , 1] = i
data[ , 2] = sample(names, nrow(data))
data[ , 3] = prop.table(sample( c(rep(0, 100), c(1:ngroup)), nrow(data)))
DAT = rbind(DAT, data)
}
colnames(DAT) <- c("x", "group", "value")
DAT <- DAT[order(DAT$x, DAT$group), ]
dim(DAT)
ggplot(DAT, aes(x = x, y = value, fill = group)) +
geom_area(alpha = 1, color = "transparent") +
theme_bw() +
scale_fill_brewer(palette = "Blues", breaks = rev(levels(DAT$group))) +
theme(line = element_blank(),
text = element_blank(),
title = element_blank(),
legend.position = "none",
panel.border = element_blank(),
panel.background = element_blank()
)
## Save plot:
# cur_name <- paste0(pic_path, "art_grass", ".png")
# ggsave(cur_name, width = 15, height = 10, units = c("cm"), dpi = 300)Harmonographs
Original version:
# Source: https://fronkonstin.com/2014/10/13/beautiful-curves-the-harmonograph/
f1 = jitter(sample(c(2,3),1)); f2 = jitter(sample(c(2,3),1)); f3 = jitter(sample(c(2,3),1)); f4 = jitter(sample(c(2,3),1))
d1 = runif(1,0,1e-02); d2=runif(1,0,1e-02); d3=runif(1,0,1e-02); d4=runif(1,0,1e-02)
p1 = runif(1,0,pi); p2=runif(1,0,pi); p3=runif(1,0,pi); p4=runif(1,0,pi)
xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
t=seq(1, 100, by=.001)
dat = data.frame(t=t, x=xt(t), y=yt(t))
with(dat, plot(x, y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))Adapted version:
# Adapted from: https://fronkonstin.com/2014/10/13/beautiful-curves-the-harmonograph/
seed <- 202
set.seed(seed)
f1 = jitter(sample(c(2, 3), 1))
f2 = jitter(sample(c(2, 3), 1))
f3 = jitter(sample(c(2, 3), 1))
f4 = jitter(sample(c(2, 3), 1))
d1 = runif(1, 0, 1e-02)
d2 = runif(1, 0, 1e-02)
d3 = runif(1, 0, 1e-02)
d4 = runif(1, 0, 1e-02)
p1 = runif(1, 0, pi)
p2 = runif(1, 0, pi)
p3 = runif(1, 0, pi)
p4 = runif(1, 0, pi)
t = seq(1, 100, by = .001)
xt = function(t) exp(-d1 * t) * sin(t * f1 + p1) +
exp(-d2 * t) * sin(t * f2 + p2)
yt = function(t) exp(-d3 * t) * sin(t * f3 + p3) +
exp(-d4 * t) * sin(t * f4 + p4)
df = data.frame(t = t, x = xt(t), y = yt(t))
df
## Plot: ------
with(df, plot(x, y, type = "l",
col = seeblau,
xlim = c(-2, 2), ylim = c(-2, 2),
xlab = "", ylab = "",
xaxt = 'n', yaxt = 'n'))
## Add text label: ------
add_label <- TRUE
if (add_label) {
cur_lbl <- "Session X: Title of current topic"
x_pos <- -2.12 # min(df$x)
y_pos <- 2.33 # max(df$y)
text(x = x_pos, y = y_pos, labels = cur_lbl, col = grey(.33, 1), adj = 0, font = 1,
xpd = TRUE # FALSE = plot region; TRUE = figure region; NA = device region.
)
}Related ideas:
- Always combine 2 similar shapes:
- wirr: perceptually random version
- klar: seemingly systematic version
- Remove frame (or make a square)
- Consider adding chapter numbers and titles?
Tunnel
# Source: Päivi Julin at <https://www.r-graph-gallery.com/206-paivi-julin/>
library(grid)
dev.new()
pushViewport(viewport(width=1, height=1, angle=0, name="vp1"))
grid.rect()
for(i in 1:54){
pushViewport(viewport(width=0.95, height=0.95, angle=5, name="vp1"))
grid.rect()
}Pi chart
Original version:
# Source: Päivi Julin at <https://www.r-graph-gallery.com/206-paivi-julin/>
data<-numeric()
data<-readLines("http://www.apup.org/images/digits100000.txt") # orig. data source http://www.geom.uiuc.edu/~huberty/math5337/groupe/digits.html
# subset of 10'000 digits
dataA<-numeric()
dataA<-substr(data,1,10000)
# colors
pal <- colorRampPalette(c("#f2f2f2", "blue"))
colors <- pal(10000)
# image settings. here manually set limits (by visual eye).
dev.new(height=7,width=7)
par(bg="black", mar=c(0,0,0,0))
plot(x=0,y=0,xlim=c(-50,70), ylim=c(-100,40))
# initial values
a_x <- a_y <- numeric()
a_x <- 0; a_y <- 0;
# loop decimals. each digit (0-9) represents an individual angle.
for(i in 1:nchar(dataA)){
a<-b_x<-b_y<-numeric()
a<-as.numeric(substr(dataA,i,i))
b_x<-a_x+sin((2*pi/10)*(a)) # orig. y pos. + change
b_y<-a_y+cos((2*pi/10)*(a)) # orig. x pos. + change
# draw points. change colors.
points(x=c(a_x,b_x),y=c(a_y,b_y),type="l", col=colors[i])
points(x=c(b_x),y=c(b_y),pch=19, col=colors[i],cex=0.3)
# initialize next round
a_x<-b_x
a_y<-b_y
}
text(x=40, y=0, labels=expression(pi), col="#f2f2f2", cex=12, pos=4) # title
text(x=52, y=10.6, labels="10000", col="black",cex=0.7, pos=4) # decimal amountAdapted version:
# Source: Päivi Julin at <https://www.r-graph-gallery.com/206-paivi-julin/>
# Data: ------
N <- 10000 # set N
## pi data:
# pi_all <- numeric()
# pi_all <- readLines("http://www.apup.org/images/digits100000.txt")
# orig. data source http://www.geom.uiuc.edu/~huberty/math5337/groupe/digits.html
pi_all <- readLines("./data/_pi/pi_100k.txt") # my version, based on http://www.geom.uiuc.edu/~huberty/math5337/groupe/digits.html
# head(pi_all) # is a string
## N digits of pi (as text string):
# pi_N <- numeric()
pi_N <- paste0(substr(pi_all, 1, 1), substr(pi_all, 3, (N - 1))) # skip the "." at position 2!
# substr(pi_N, 1, 10)
## Colors: ------
# pal <- colorRampPalette(c("#f2f2f2", "blue"))
## Based on:
unikn.pal
# pal <- colorRampPalette(c("white", seeblau)) # on black
pal <- colorRampPalette(c(unikn.pal[[4]], grey(.35, 1))) # on white
pi_col <- pal(N)
# Image settings: ------
# dev.new(height = 7, width = 7)
# par(bg = "black", mar = c(0, 0, 0, 0))
par(bg = "white", mar = rep(.20, 4))
x_min <- -100
x_max <- 165
y_min <- -165
y_max <- 100
plot(x = 0, y = 0, type = "n",
xlim = c(x_min, x_max), ylim = c(y_min, y_max),
xlab = "", ylab = "",
xaxt = 'n', yaxt = 'n'
)
# initial values:
a_x <- a_y <- numeric()
a_x <- 0
a_y <- 0
# Loop: each digit (0-9) represents an individual angle:
for(i in 1:nchar(pi_N)){
# b_x <- b_y
# a <- b_x
a <- as.numeric(substr(pi_N, i, i))
scale <- 2.0 # Constant scaling factor. Original: scale <- 1.0
# Next points:
b_x <- a_x + (scale * sin((2 * pi/10) * a)) # orig. y pos. + change
b_y <- a_y + (scale * cos((2 * pi/10) * a)) # orig. x pos. + change
# Draw lines, points & change colors:
points(x = c(a_x, b_x), y = c(a_y, b_y), type = "l", col = pi_col[i])
points(x = c(b_x), y = c(b_y), pch = 19, col = pi_col[i], cex = 0.3)
# For next round:
a_x <- b_x
a_y <- b_y
}
## Text label: ------
lbl_x <- +80
lbl_y <- -15
# text(x = lbl_x, y = lbl_y, labels = expression(pi), col = grey(.60, 1), cex = 8, pos = 2) # title
# text(x = (lbl_x + 4), y = (lbl_y - 5), labels = paste0(N), col = grey(.15, 1), cex = .7, pos = 2) # N of digits
N_k <- round(N/1000, 0)
cur_lbl <- paste0(expression(pi), " to ", N_k, "k digits")
text(x = (x_max - 10), y = y_min, labels = cur_lbl, col = grey(.33, 1), cex = .7, pos = NULL)Ideas
Various ideas by category (or data type):
Word art
Geographic art
- tube lines
- maps with color schemes
Numeric art
- randomness (e.g., pi)
Organic art
- networks
- webs (e.g., strange attractors)
- flowers (e.g., https://fronkonstin.com/)
Graphic art
- paint brush effects
Links
Provide links to all code sources and inspirations:
Grab bag: R graph gallery at https://www.r-graph-gallery.com/portfolio/data-art/
Wonderful creations by Antonio Sánchez Chinchón at https://fronkonstin.com/:
Coloring sudokus: blog
Phyllotaxis: Draw flowers using mathematics: DataCamp; see also Shiny app at https://stocks.shinyapps.io/phylo/
Inspiring pi and text art by Päivi Julin at http://www.apup.org
Artwork by Marcus Volz at https://marcusvolz.com/
[This file last updated on 2019-02-12 09:19:22 by hn.]